The 640 MEG Shareware Studio 2/The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO/bbs/mfm_111b.zip/SETUP.PAS

Pascal/Delphi Source File | 1992-01-07 | 8KB | 259 lines

{========================================================================}
Function OkToAdd(InString : String) : Boolean;
  Var
    Otab : Byte;
  Begin
    If (MaxAvail > SizeOf(ListRecord)) Then
    Begin
      OkToAdd := True;
      For Otab := 1 To 10 Do If Pos(SkipList[Otab],UpperString(InString)) = 1 Then OkToAdd := False;
    End
    Else
    Begin
      OkToAdd := False;
    End;
  End;
{========================================================================}
Function CommentEntry : Boolean;
  Begin
    CommentEntry := False;
    If Length(WorkString) = 0 Then CommentEntry := True;
    If Copy(WorkString,1,1) = ' ' Then CommentEntry := True;
    If Copy(WorkString,1,1) = '-' Then CommentEntry := True;
    If Pos(WorkString[1],Base153) = 0 Then CommentEntry := True;
  End;
{========================================================================}
Procedure FindOrphans;
  Var
    FileFound : Boolean;
    SearchEntry : ListPtr;
  Begin
    FileFound := False; SearchEntry := FirstEntry;
    If FilesBbs Then
    Begin
      While (Not FileFound) And (SearchEntry^.NextEntry <> NIL) Do
      Begin
        If DirInfo.Name = SearchEntry^.FileName Then FileFound := True;
        SearchEntry := SearchEntry^.NextEntry;
      End;
    End;
    If FilesBbs Then
    Begin
      If (Not FileFound) And (DirInfo.Name <> SearchEntry^.FileName) Then
      Begin
        If OkToAdd(DirInfo.Name) Then
        Begin
          New(NewEntry);
          If NumberOfEntries = 0 Then
          Begin
            FirstEntry := NewEntry;
            NewEntry^.PrevEntry := NIL;
            OldEntry := FirstEntry;
          End
          Else
          Begin
            NewEntry^.PrevEntry := OldEntry;
            OldEntry^.NextEntry := NewEntry;
            OldEntry := NewEntry;
          End;
          NewEntry^.TypeOfRecord := Orphan;
          NewEntry^.FileName := DirInfo.Name;
          NewEntry^.FileSize := DirInfo.Size;
          If DirInfo.Name <> 'FILES.BBS' Then
          Begin
            SizeOfFiles := SizeOfFiles + DirInfo.Size;
            Inc(NumberOfFiles);
          End;
          NewEntry^.FileDate := DirInfo.Time;
          NewEntry^.Description := '';
          NewEntry^.Tagged := False;
          Inc(NumberOfEntries);
        End;
      End;
    End
    Else
    Begin
      If Not FileFound Then
      Begin
        If MaxAvail > SizeOf(ListRecord) Then
        Begin
          New(NewEntry);
          NewEntry^.Tagged := False;
          If NumberOfEntries = 0 Then
          Begin
            FirstEntry := NewEntry;
            NewEntry^.PrevEntry := NIL;
            OldEntry := FirstEntry;
          End
          Else
          Begin
            NewEntry^.PrevEntry := OldEntry;
            OldEntry^.NextEntry := NewEntry;
            OldEntry := NewEntry;
          End;
          NewEntry^.TypeOfRecord := Orphan;
          NewEntry^.FileName := DirInfo.Name;
          NewEntry^.FileSize := DirInfo.Size;
          If DirInfo.Name <> 'FILES.BBS' Then
          Begin
            SizeOfFiles := SizeOfFiles + DirInfo.Size;
            Inc(NumberOfFiles);
          End;
          NewEntry^.FileDate := DirInfo.Time;
          NewEntry^.Description := '';
          Inc(NumberOfEntries);
        End;
      End;
    End;
  End;
{========================================================================}
Procedure BuildList;
  Begin
    NumberOfEntries := 0; FilesBbs := True; Altered := False;
    SizeOfFiles := 0; NumberOfFiles := 0;
    Assign(FileList,FileAreaPath+'FILES.BBS');
    FileMode := 64;
    {$I-} Reset(FileList); {$I+}
    If IOresult = 0 Then
    Begin
      AnsiGotoXY(25,1); NewTextColor(White); NewTextBackground(Black);
      AnsiClearToEOL; Write('Loading FILES.BBS ...');
      While Not Eof(FileList) Do
      Begin
        ReadLn(FileList,WorkString);
        If OkToAdd(WorkString) Then
        Begin
          Inc(NumberOfEntries);
          If CommentEntry Then
          Begin
            New(NewEntry);
            NewEntry^.TypeOfRecord := Comment;
            NewEntry^.FileName := '';
            NewEntry^.FileSize := 0;
            NewEntry^.FileDate := 0;
            NewEntry^.Description := WorkString;
            NewEntry^.Tagged := False;
            If NumberOfEntries = 1 Then
            Begin
              FirstEntry := NewEntry;
              NewEntry^.PrevEntry := NIL;
              OldEntry := FirstEntry;
            End
            Else
            Begin
              NewEntry^.PrevEntry := OldEntry;
              OldEntry^.NextEntry := NewEntry;
              OldEntry := NewEntry;
            End;
          End
          Else
          Begin
            New(NewEntry);
            NewEntry^.Tagged := False;
            If NumberOfEntries = 1 Then
            Begin
              FirstEntry := NewEntry;
              NewEntry^.PrevEntry := NIL;
              OldEntry := FirstEntry;
            End
            Else
            Begin
              NewEntry^.PrevEntry := OldEntry;
              OldEntry^.NextEntry := NewEntry;
              OldEntry := NewEntry;
            End;
            If Pos(' ',WorkString) = 0 Then
            Begin
              NewEntry^.FileName := UpperString(WorkString);
            End
            Else
            Begin
              NewEntry^.FileName := UpperString(Copy(Copy(WorkString,1,Pos(' ',WorkString)-1),1,12));
            End;
            FindFirst(FileAreaPath+NewEntry^.FileName,AnyFile,DirInfo);
            If DosError = 0 Then
            Begin
              NewEntry^.TypeOfRecord := FileRecord;
              NewEntry^.FileSize := DirInfo.Size;
              SizeOfFiles := SizeOfFiles + DirInfo.Size;
              Inc(NumberOfFiles);
              NewEntry^.FileDate := DirInfo.Time;
              If Pos(' ',WorkString) = 0 Then
              Begin
                NewEntry^.Description := '';
              End
              Else
              Begin
                NewEntry^.Description := LtrimRtrim(Copy(WorkString,Pos(' ',WorkString)+1,144));
              End;
            End
            Else
            Begin
              NewEntry^.TypeOfRecord := Offline;
              NewEntry^.FileSize := 0;
              NewEntry^.FileDate := 0;
              If Pos(' ',WorkString) = 0 Then
              Begin
                NewEntry^.Description := '';
              End
              Else
              Begin
                NewEntry^.Description := LtrimRtrim(Copy(WorkString,Pos(' ',WorkString)+1,144));
              End;
            End;
          End;
        End;
      End;
      Close(FileList);
      NewEntry^.NextEntry := NIL;
      If NumberOfEntries = 0 Then FilesBbs := False;
    End
    Else
    Begin
      FilesBbs := False;
    End;
    FindFirst(FileAreaPath+'*.*',Archive,DirInfo);
    If DosError = 0 Then FindOrphans;
    While DosError = 0 Do
    Begin
      NewEntry^.NextEntry := NIL;
      FindNext(DirInfo);
      If DosError = 0 Then FindOrphans;
    End;
    LastEntry := NewEntry;
    LastEntry^.NextEntry := NIL;
    StackEntry := NIL; KillEntry := NIL;
    AnsiGotoXY(25,1); AnsiClearToEOL;
  End;
{========================================================================}
Function Bytes(NumberOfBytes : LongInt) : S8;
  Var
    TempString : S8;
  Begin
    If NumberOfBytes < 1024 Then
    Begin
      TempString := MyStr(NumberOfBytes,4)+'K';
    End
    Else
    Begin
      Str(NumberOfBytes/1024:3:1,TempString);
      TempString := TempString+'M';
    End;
    Bytes := TempString;
  End;
{========================================================================}
Procedure SetupScreen;
  Begin
    NewTextColor(White); NewTextBackground(Black);
    AnsiClearScreen; AnsiGotoXY(24,1);
    NewTextColor(Black); NewTextBackground(Cyan);
    Write(Pgmid+'      ^Q=quit ?=help');
    NewTextColor(White); NewTextBackground(Black);
  End;
{========================================================================}
Procedure ReDrawScreen;
  Begin
    SetupScreen; DisplayScreen;
  End;
{========================================================================}